home *** CD-ROM | disk | FTP | other *** search
/ Dr. Windows 3 / dr win3.zip / dr win3 / VISUALBA / BLTQ12.ZIP / BB_CIU10.BAS < prev    next >
BASIC Source File  |  1993-01-04  |  15KB  |  536 lines
  1.  
  2. DEFINT A-Z
  3.  
  4. REM $INCLUDE: 'BULLET.BI'
  5. 'bb_ciu10.bas 31-May-92 chh
  6. '--example using 8-char key, dups and         
  7. '--a second index of LONG INT (on SSN field), unique to check Update xaction
  8.  
  9. 'this example shows the transaction-based feature of UpdateXB--it purposely
  10. 'inserts to the two index files, and then will do Updates of already existing
  11. 'SSN key, thus causing all the Updates to be backed-out except the
  12. 'very last (since the last is changed in a way that no current key matches)
  13. 'See BB_CIN10.BAS for more on transaxtion-based info
  14.  
  15. 'this code is for a simplistic database
  16. 'it uses a single DBF (true DBF-compat) and two related indexes
  17. 'the first index is on the first 5 chars of last name + first char first name
  18. 'second index is on the SSN, since it's a valid LONG INT we use that key type
  19.  
  20. 'C>bc bb_ciu10 /o;
  21. 'C>link bb_ciu10,,nul,bullet;
  22.  
  23. UseDir$ = ".\"                  'all files use this directory except
  24.                                 'the reindex work file which uses the
  25.                                 'SET TMP= directory or the current directory
  26. CLS
  27. PRINT "BB_CIU10.BAS - 8-CHAR (DUPS) and LONG INT (UNIQUE), UpdateXB example"
  28. PRINT "--maintains *2* index files automatically, using NLS sorting."
  29. PRINT ">> USING DIRECTORY "; UseDir$
  30. PRINT
  31.  
  32. TYPE TestRecTYPE
  33. Tag AS STRING * 1
  34. FirstName AS STRING * 15        'a DBF C fieldtype
  35. LastName AS STRING * 19         'C
  36. SSN AS STRING * 9               'N (use C instead to use SUBSTR() on it)
  37. BDate AS STRING * 8             'D
  38. DeptNo AS STRING * 3            'C
  39. Salary AS STRING * 9            'N
  40. END TYPE '64                    'DBF III+ limit is 4000 bytes/128 fields
  41.                                 
  42. DIM DFP AS DOSFilePack
  43. DIM MP AS MemoryPack
  44. DIM IP AS InitPack
  45. DIM EP AS ExitPack
  46. DIM CDP AS CreateDataPack
  47. DIM CKP AS CreateKeyPack
  48. DIM OP AS OpenPack
  49. DIM AP(1 TO 2) AS AccessPack    '2 since we're maintaining 2 index files
  50. DIM SDP AS StatDataPack
  51. DIM SKP AS StatKeyPack
  52. DIM XEP AS XErrorPack
  53.  
  54. DIM FieldList(1 TO 6) AS FieldDescTYPE
  55. DIM TestRec AS TestRecTYPE
  56. DIM ZSTR AS STRING * 1
  57. DIM NameDAT AS STRING * 80      'DBF data file
  58. DIM NameIX1 AS STRING * 80      'first index file
  59. DIM NameIX2 AS STRING * 80      'second index file
  60. DIM KX1 AS STRING * 136         'key expression for first index file
  61. DIM KX2 AS STRING * 136         'key expression for second index file
  62. DIM KeyBuffer AS STRING * 64
  63.  
  64. DIM First$(1 TO 26)
  65. DIM Last$(1 TO 26)
  66. GOSUB FillNamesIn
  67.  
  68. ZSTR = CHR$(0)
  69. NameDAT = UseDir$ + "CHARTEST.DBF" + ZSTR
  70. NameIX1 = UseDir$ + "CHARTEST.IX1" + ZSTR
  71. NameIX2 = UseDir$ + "CHARTEST.IX2" + ZSTR
  72.  
  73. FieldList(1).FieldName = "FIRSTNAME" + ZSTR
  74. FieldList(1).FieldType = "C"
  75. FieldList(1).FieldLength = CHR$(15)
  76. FieldList(1).FieldDC = CHR$(0)
  77. FieldList(2).FieldName = "LASTNAME" + ZSTR + ZSTR
  78. FieldList(2).FieldType = "C"
  79. FieldList(2).FieldLength = CHR$(19)
  80. FieldList(2).FieldDC = CHR$(0)
  81. FieldList(3).FieldName = "SSN" + STRING$(7, 0)
  82. FieldList(3).FieldType = "N"
  83. FieldList(3).FieldLength = CHR$(9)
  84. FieldList(3).FieldDC = CHR$(0)
  85. FieldList(4).FieldName = "BDATE" + STRING$(5, 0)
  86. FieldList(4).FieldType = "D"
  87. FieldList(4).FieldLength = CHR$(8)
  88. FieldList(4).FieldDC = CHR$(0)
  89. FieldList(5).FieldName = "DEPTNO" + STRING$(4, 0)
  90. FieldList(5).FieldType = "C"
  91. FieldList(5).FieldLength = CHR$(3)
  92. FieldList(5).FieldDC = CHR$(0)
  93. FieldList(6).FieldName = "SALARY" + STRING$(4, 0)
  94. FieldList(6).FieldType = "N"
  95. FieldList(6).FieldLength = CHR$(9)
  96. FieldList(6).FieldDC = CHR$(2)
  97.  
  98. level = 100
  99. MP.Func = MemoryXB
  100. stat = BULLET(MP)
  101. IF MP.Memory < 140000 THEN
  102.     QBheap& = SETMEM(-150000)       'hog wild, 64K would do okay
  103.     MP.Func = MemoryXB
  104.     stat = BULLET(MP)
  105.     IF MP.Memory < 140000 THEN stat = 8: GOTO Abend
  106. END IF
  107. PRINT "free DGROUP:"; FRE(a$)
  108.  
  109. level = 110
  110. IP.Func = InitXB
  111. IP.JFTmode = 0
  112. stat = BULLET(IP)
  113. IF stat THEN GOTO Abend
  114.  
  115. level = 120
  116. EP.Func = AtExitXB
  117. stat = BULLET(EP)
  118.  
  119. level = 130
  120. DFP.Func = DeleteFileDOS
  121. DFP.FilenamePtrOff = VARPTR(NameDAT)
  122. DFP.FilenamePtrSeg = VARSEG(NameDAT)
  123. stat = BULLET(DFP)
  124. DFP.FilenamePtrOff = VARPTR(NameIX1)
  125. DFP.FilenamePtrSeg = VARSEG(NameIX1)
  126. stat = BULLET(DFP)
  127. DFP.FilenamePtrOff = VARPTR(NameIX2)
  128. DFP.FilenamePtrSeg = VARSEG(NameIX2)
  129. stat = BULLET(DFP)
  130.  
  131. level = 1000
  132. CDP.Func = CreateDXB
  133. CDP.FilenamePtrOff = VARPTR(NameDAT)
  134. CDP.FilenamePtrSeg = VARSEG(NameDAT)
  135. CDP.NoFields = 6
  136. CDP.FieldListPtrOff = VARPTR(FieldList(1))
  137. CDP.FieldListPtrSeg = VARSEG(FieldList(1))
  138. CDP.FileID = 3
  139. stat = BULLET(CDP)
  140. IF stat THEN GOTO Abend
  141.  
  142. level = 1010
  143. OP.Func = OpenDXB
  144. OP.FilenamePtrOff = VARPTR(NameDAT)
  145. OP.FilenamePtrSeg = VARSEG(NameDAT)
  146. OP.ASmode = ReadWrite + DenyNone
  147. stat = BULLET(OP)
  148. IF stat THEN GOTO Abend
  149. HandDAT = OP.Handle
  150.  
  151. level = 1100
  152. KX1 = "SUBSTR(LASTNAME,1,5)+SUBSTR(FIRSTNAME,1,1)"
  153. CKP.Func = CreateKXB
  154. CKP.FilenamePtrOff = VARPTR(NameIX1)
  155. CKP.FilenamePtrSeg = VARSEG(NameIX1)
  156. CKP.KeyExpPtrOff = VARPTR(KX1)
  157. CKP.KeyExpPtrSeg = VARSEG(KX1)
  158. CKP.XBlink = HandDAT
  159. CKP.KeyFlags = cCHAR
  160. CKP.CodePageID = -1
  161. CKP.CountryCode = -1
  162. CKP.CollatePtrOff = 0
  163. CKP.CollatePtrSeg = 0
  164. stat = BULLET(CKP)
  165. IF stat THEN GOTO Abend
  166.  
  167. level = 1102
  168. KX2 = "SSN"
  169. CKP.Func = CreateKXB
  170. CKP.FilenamePtrOff = VARPTR(NameIX2)
  171. CKP.FilenamePtrSeg = VARSEG(NameIX2)
  172. CKP.KeyExpPtrOff = VARPTR(KX2)
  173. CKP.KeyExpPtrSeg = VARSEG(KX2)
  174. CKP.XBlink = HandDAT
  175. CKP.KeyFlags = cLONG + cSIGNED + cUNIQUE 'test transaction ability by forcing
  176. CKP.CodePageID = -1                      'duplicate SSN numbers
  177. CKP.CountryCode = -1
  178. CKP.CollatePtrOff = 0
  179. CKP.CollatePtrSeg = 0
  180. stat = BULLET(CKP)
  181. IF stat THEN GOTO Abend
  182.  
  183. level = 1110
  184. OP.Func = OpenKXB
  185. OP.FilenamePtrOff = VARPTR(NameIX1)
  186. OP.FilenamePtrSeg = VARSEG(NameIX1)
  187. OP.ASmode = ReadWrite + DenyNone
  188. OP.xbHandle = HandDAT
  189. stat = BULLET(OP)
  190. IF stat THEN GOTO Abend
  191. HandIX1 = OP.Handle
  192.  
  193. level = 1112
  194. OP.Func = OpenKXB
  195. OP.FilenamePtrOff = VARPTR(NameIX2)
  196. OP.FilenamePtrSeg = VARSEG(NameIX2)
  197. OP.ASmode = ReadWrite + DenyNone
  198. OP.xbHandle = HandDAT
  199. stat = BULLET(OP)
  200. IF stat THEN GOTO Abend
  201. HandIX2 = OP.Handle
  202.  
  203. AP(1).Func = InsertXB
  204. AP(1).Handle = HandIX1
  205. AP(1).RecPtrOff = VARPTR(TestRec)
  206. AP(1).RecPtrSeg = VARSEG(TestRec)
  207. AP(1).KeyPtrOff = VARPTR(KeyBuffer)
  208. AP(1).KeyPtrSeg = VARSEG(KeyBuffer)
  209. AP(1).NextPtrOff = VARPTR(AP(2))
  210. AP(1).NextPtrSeg = VARSEG(AP(2))
  211. AP(2).Func = InsertXB
  212. AP(2).Handle = HandIX2
  213. AP(2).RecPtrOff = VARPTR(TestRec)
  214. AP(2).RecPtrSeg = VARSEG(TestRec)
  215. AP(2).KeyPtrOff = VARPTR(KeyBuffer)
  216. AP(2).KeyPtrSeg = VARSEG(KeyBuffer)
  217. AP(2).NextPtrOff = 0
  218. AP(2).NextPtrSeg = 0
  219.  
  220. level = 1200
  221. 'keep Recs to insert below 1000 since there SSN values generated in this
  222. 'example range from 100000000 to 1000000999
  223.  
  224. INPUT "(suggest no more than 1000) Recs to insert:"; Recs2Add&
  225. PRINT "Inserting record:";
  226. herecol = POS(0)
  227.  
  228. 'these are not key values so just make them constant for this example
  229.  
  230. TestRec.Tag = " "
  231. TestRec.BDate = "19331122"   'yes, everyone is the same age
  232. TestRec.DeptNo = "001"       'yes, same dept too
  233. TestRec.Salary = "125000.77" 'and even the same salary
  234.  
  235. 'RANDOMIZE TIMER
  236. level = 1200
  237. GOSUB StartTimer
  238. FOR Recs& = 1 TO Recs2Add&
  239.  
  240.    'we want to know what's being used so we can verify that all was restored
  241.  
  242.    TestRec.FirstName = First$(1 + Recs& MOD 25)
  243.    TestRec.LastName = Last$(1 + Recs& MOD 25)
  244.    TestRec.SSN = STR$(Recs&)
  245.  
  246.    stat = 0
  247.    LOCATE , herecol
  248.    PRINT Recs&;
  249.  
  250.    sidx = BULLET(AP(1))
  251.    IF sidx = 0 AND AP(1).stat THEN
  252.       'error on data record add portion of insert
  253.       stat = AP(1).stat
  254.       GOTO Abend                        'consider this a fatal error
  255.    ELSEIF sidx THEN
  256.       stat = AP(sidx).stat
  257.       IF stat <> 201 THEN
  258.          GOTO Abend                     'this too
  259.       ELSE  'key already exists test    'a key already exists just skip
  260.          'won't happen in this example since we have duplicates okay
  261.          'for the first index file
  262.          STOP
  263.       END IF
  264.    END IF
  265.  
  266. NEXT
  267. GOSUB EndTimer
  268. LOCATE , 60
  269. PRINT "..."; secs&; "secs."
  270.  
  271.  
  272. PRINT  'show the first 5 data record in recno order (original data)
  273. PRINT "...the first 5 recs data